home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / bavarian / 001-010 / 008_dateien / datei 2 / address next >
Text File  |  1993-11-04  |  21KB  |  786 lines
  1. 'AMIGA ADDRESS ** CAPACITY OF 1225 ENTRIES ** VER.1.0
  2. 'QUICK SEARCH IN EVERY FIELD ** MARK HURST (503)-843-3185 
  3.  
  4. CLEAR ,65000&
  5. DEFINT a-z
  6.  WINDOW 1,"* * *  AMIGA ADDRESS  * * *",(0,0)-(440,114),23
  7.   DIM a$(9),m(8),n(50),p$(9,4),index$(9,4),label$(21)
  8.   bit=1
  9. ON ERROR GOTO 6000
  10. OPEN "address.ind" FOR  INPUT AS 2
  11.   FOR x=1 TO 9
  12.     bin(x)=bit
  13.     FOR y=0 TO 4
  14.       INPUT #2,index$(x,y)
  15.     NEXT y
  16.     bit=bit*2
  17.   NEXT x
  18.   CLOSE #2
  19. FOR x=1 TO 10
  20.  READ title$(x)
  21.   NEXT
  22. FOR x=13 TO 21
  23.  READ label$(x)
  24.   NEXT
  25. ON ERROR GOTO 0
  26.   DATA NAME 1,NAME 2,ADDRESS 1,ADDRESS 2,CITY
  27.   DATA STA.ZIP,PHONE,TITLE 1,TITLE 2,
  28.   DATA MAIL ADDRESS LABELS,ADDRESS BOOK LABELS,MASTER FILE
  29.   DATA FIRST NAME FIRST,FIRST NAME LAST,CHOOSE RECORD #
  30.   DATA MATCH FIELD STRING,MATCH RECORD STRING,ALL RECORDS
  31.  
  32. job=1
  33.  recsel=4
  34.   name1=1
  35.    pfield=53
  36.     sortp$="000000000"
  37.      savefile=0
  38.  
  39. OPEN "address.dat" AS 2 LEN=262
  40. FIELD 2,35 AS n1$,35 AS n2$,35 AS ad1$,35 AS ad2$,20 AS city$,20 AS state$,12 AS ph$,35 AS t1$,35 AS t2$
  41. screen.refresh:
  42.   LOCATE 3,1:COLOR 1,2
  43. FOR x=1 TO 9
  44.  PRINT TAB(10-LEN(title$(x)));title$(x)
  45.   NEXT
  46. COLOR 1,0:LOCATE 1,18:PRINT "*** RECORD NUMBER  "
  47.  
  48.  rec=1
  49.  IF LOF(2)>0 THEN
  50.    GET 2,1
  51.    GOSUB 710
  52.    GOSUB 700
  53.  END IF
  54.  
  55. MENU 1,0,1,"RECORD FUNCTIONS"
  56. MENU 1,1,1,"Input & Edit Record"
  57. MENU 1,2,1,"Add Record"
  58. MENU 1,3,1,"Delete Current Record"
  59. MENU 1,4,1,"Hardcopy"
  60. MENU 2,0,1,"SEARCHES"
  61. MENU 2,1,1,"Field Search"
  62. MENU 2,2,1,"Record Search"
  63. MENU 2,3,1,"Get Record Number"
  64. MENU 3,0,1,"MAITENENCE"
  65. MENU 3,1,1,"Data Backup"
  66. MENU 3,2,1,"Restore Index File"
  67. MENU 3,3,1,"Exit Amiga Address"
  68. MENU 4,0,1,""
  69. LINE (0,0)-(48,11),3,bf:LINE(392,0)-(440,11),3,bf
  70. COLOR 2,3:LOCATE 1,2:PRINT"LAST"TAB(51)"NEXT"
  71.  COLOR 1,0
  72.  ON MENU GOSUB main.menu
  73. 120 MENU ON
  74. 121 IF MOUSE(0)>-1 THEN 121
  75.  IF MOUSE(2)<12 THEN
  76.    IF MOUSE(1)<40 THEN GOSUB 140
  77.    IF MOUSE(1)>392 AND MOUSE(1)<440 THEN GOSUB 150
  78.  END IF  
  79.  GOTO 121
  80. main.menu:
  81. ON MENU(0) GOTO 1,2,3
  82. 1 ON MENU(1) GOTO 300,600,500,4000
  83. 2 ON MENU(1) GOTO 400,200,1000
  84. 3 ON MENU(1) GOTO 920,2060,900 
  85.  
  86.    '****** BACK ONE RECORD ********
  87. 140   IF change THEN GOSUB 800
  88.       IF rec>1 THEN rec=rec-1 ELSE rec=LOF(2)/262
  89.       GET 2,rec
  90.       GOSUB 710
  91.       GOSUB 700:RETURN
  92.  
  93.    '******** UP ONE RECORD ***********
  94. 150   IF change THEN GOSUB 800
  95.       IF rec<LOF(2)/262 THEN GET 2:rec=rec+1 ELSE rec=1:GET 2,1
  96.       GOSUB 710
  97.       GOSUB 700
  98.       RETURN
  99.    '******* RECORD SEARCH *********
  100. 200   
  101.        WINDOW 9,"* * * Record Search * * *",(0,105)-(350,160),0
  102. 215   found=0
  103.        CLS
  104.         LINE INPUT"SEARCHING FOR ? ";search$
  105.          search$=UCASE$(search$)
  106. 220   GET 2,1
  107.        FOR rec=1 TO LOF(2)/266-1
  108.          GET 2:GOSUB 710
  109.          FOR look=1 TO 9
  110.            p=INSTR(UCASE$(a$(look)),search$)
  111.            IF p=0 THEN 240
  112.            WINDOW OUTPUT 1:COLOR 1,0
  113.            found=1:GOSUB 700
  114.            LOCATE look+2,1:COLOR 1,3
  115.            PRINT TAB(11);a$(look)
  116.            WINDOW OUTPUT 9
  117.            GOSUB 470
  118.            COLOR 1,0
  119.            ON INT(MOUSE(1)/103)+1 GOTO 240,215,275
  120. 240   NEXT look,rec
  121.        GOSUB 430
  122.         ON INT(x/103)+1 GOTO 220,215,275
  123. 275   WINDOW CLOSE 9:GOTO 120
  124.  
  125.    '******* INPUT DATA ********
  126. 300   savefile=1:change=1
  127.   LOCATE 13,1:COLOR 0,1
  128.   PRINT"INPUT & EDIT - Use arrow keys or Mouse to move cursor"
  129.   PRINT"Hit `ESC' key to Quit input and edit";
  130.   COLOR 1,0
  131.   gettext 9,3,11,35,a$(),3,0
  132.   LOCATE 13,1:PRINT SPACE$(53):PRINT SPACE$(52);
  133.   GOSUB 800
  134.   GOTO 120
  135.  
  136.    '******* FIELD SEARCHES *******
  137. 400   storerec=rec
  138. 402   COLOR 3,2:LOCATE 13,1:PRINT"Select FIELD to Search in with MOUSE"
  139.       LOCATE 14,1:PRINT"Hit the `ESC' key to Exit Search"; 
  140. 403   a$=INKEY$
  141.       IF a$=CHR$(27) THEN
  142.         COLOR 1,0:LOCATE 13,1
  143.         PRINT SPACE$(36):PRINT SPACE$(36);
  144.         GOTO 120
  145.       END IF  
  146.       IF MOUSE(0)>-1 THEN 403
  147.       y=MOUSE(2):x=MOUSE(1)
  148.       IF x>100 OR y<16 OR y>87  THEN 403 
  149. 408  COLOR 1,0:LOCATE 13,1:PRINT SPACE$(36):PRINT SPACE$(36);
  150.       fpos=INT((y-8)/8):LOCATE fpos+2,1
  151.        COLOR 3,2
  152.         tb=10-LEN(title$(fpos))
  153. 409   PRINT TAB(tb);title$(fpos)
  154.       COLOR 1,0
  155. 410   WINDOW 9,"* * * Field Search * * *",(0,105)-(350,160),0
  156. 412   found=0
  157.        book=-1
  158.         rec=1
  159.          LINE INPUT"SEARCHING FOR ? ";search$
  160.          search$=UCASE$(search$)
  161. 413   IF book=4 THEN
  162.         GOSUB 428
  163.       ELSE
  164.         book=book+1
  165.         IF rec>LOF(2)/262 THEN GOSUB 428
  166.       END IF  
  167. 414   cpos=INSTR(rec-(book*245),index$(fpos,book),LEFT$(search$,1))
  168. 416   IF cpos=0 THEN rec=((book+1)*246):GOTO 413
  169. 420   found=1
  170.        rec=cpos+(book*245)
  171.         GET 2,rec
  172.          GOSUB 455
  173. 422   IF search$=UCASE$(LEFT$(fstr$,LEN(search$))) THEN
  174.           storerec=rec:WINDOW OUTPUT 1
  175.           GOSUB 710
  176.           GOSUB 700:WINDOW OUTPUT 9
  177.         GOSUB 470
  178.         GOSUB 475
  179.       ELSE
  180.         rec=rec+1
  181.       END IF
  182. 424   IF found=2 THEN 450
  183. 426   GOTO 414
  184. 428   GOSUB 430:GOTO 446
  185.  
  186.    '******* END OF FILE ********
  187. 430   CLS
  188.       IF found=0 THEN
  189.         PRINT "--- """search$""" NOT FOUND ---"
  190.         GOTO 434
  191.       END IF  
  192. 432   found=0:PRINT "*** END OF THE FILE ***"
  193. 434   LINE(0,27)-(98,51),3,bf
  194.        LINE(106,27)-(204,51),3,bf
  195.         LINE(212,27)-(310,51),3,bf
  196. 436   LOCATE 5,4:COLOR 2,3
  197.        PRINT "REPEAT";TAB(16);"ANOTHER";TAB(31);"QUIT"
  198.         PRINT TAB(4);"SEARCH";TAB(17);"SEARCH";TAB(29);"SEARCHING";
  199. 442   IF MOUSE(0)>-1 THEN 442
  200. 444   IF MOUSE(2)>27 THEN IF MOUSE(2)<51 THEN IF MOUSE(1)<310 THEN RETURN
  201.       GOTO 442
  202. 446   ON INT(MOUSE(1)/103)+1 GOTO 448,450,452
  203. 448   book=-1:rec=1:GOTO 413
  204. 450   WINDOW CLOSE 9:COLOR 1,2
  205.       LOCATE fpos+2,tb:PRINT title$(fpos);
  206.       GOTO 402
  207. 452   rec=storerec:WINDOW CLOSE 9:COLOR 1,2
  208.       LOCATE fpos+2,tb:PRINT title$(fpos)
  209.       COLOR 1,0:GOTO 120
  210.  
  211.      '****** FIELD STRING EQUATE TO FSTR$ ******
  212. 455   ON fpos GOTO 456,457,458,459,460,461,462,463,464
  213. 456   fstr$=n1$:RETURN
  214. 457   fstr$=n2$:RETURN
  215. 458   fstr$=ad1$:RETURN
  216. 459   fstr$=ad2$:RETURN
  217. 460   fstr$=city$:RETURN
  218. 461   fstr$=state$:RETURN
  219. 462   fstr$=ph$:RETURN
  220. 463   fstr$=t1$:RETURN
  221. 464   fstr$=t2$:RETURN
  222.      '***** SEARCH  next restart quit *****
  223. 470   CLS
  224.       LINE(0,27)-(98,43),3,bf
  225.        LINE(106,27)-(204,43),3,bf
  226.         LINE(212,27)-(310,43),3,bf
  227. 471   LOCATE 5,1
  228.       PRINT TAB(4);"NEXT";
  229.       PRINT TAB(16);"RESTART";
  230.       PRINT TAB(31);"QUIT";
  231.       COLOR 1,0
  232. 472   IF MOUSE(0)>-1 THEN 472
  233. 473   IF MOUSE(2)>27 THEN IF MOUSE(2)<43 THEN IF MOUSE(1)<310 THEN RETURN
  234. 474   GOTO 472
  235. 475   ON INT(MOUSE(1)/103)+1 GOTO 476,477,478
  236. 476   rec=rec+1:RETURN
  237. 477   book=0:rec=1:found=0:RETURN
  238. 478   found=2:RETURN
  239.  
  240.      '****** DELETE RECORD ********
  241. 500   savefile=1
  242.       requester 0,80,116,"Delete this record ?",1,"YES","NO"   
  243.       WINDOW CLOSE 3
  244.        ON answer GOTO 570,580
  245. 570   FOR x=1 TO 9:a$(x)=" ":NEXT x
  246.        GOSUB 800:GOSUB 710:GOSUB 700
  247. 580   GOTO 120
  248.  
  249.       '***** ADD  RECORD TO FILE ********
  250. 600   FOR book=0 TO 4:p=0
  251. 605   p=INSTR(p+1,index$(1,book)," ")  
  252.       IF p=0 THEN 680
  253.        FOR chap=1 TO 9
  254.         IF MID$(index$(chap,book),p,1)<>" " THEN 605
  255.        NEXT chap
  256.        rec=book*245+p:GET 2,rec:GOTO 695
  257. 680   NEXT book
  258.       rec=LOF(2)/262+1
  259. 695   FOR x=1 TO 9
  260.        a$(x)=STRING$(35,32)
  261.       NEXT x
  262.       GOSUB 700:GOTO 300
  263.  
  264.       '******* PUT DATA ON SCREEN *******
  265. 700   LOCATE 1,36:PRINT rec" ***   "
  266.       PRINT
  267.       FOR x=1 TO 9:PRINT TAB(11);a$(x)
  268.       NEXT x 
  269.       RETURN
  270.  
  271. 709   '******* CONVERT DATA TO ARRAY *******
  272. 710   a$(1)=n1$:a$(2)=n2$:a$(3)=ad1$:a$(4)=ad2$
  273.       a$(5)=city$:a$(6)=state$:a$(7)=ph$:a$(8)=t1$
  274.       a$(9)=t2$:IF nf=1 THEN GOSUB 720
  275.       RETURN
  276.  
  277.      '***** FIRST NAME FIRST
  278. 720   p=INSTR(1,a$(1),","):IF p=0 THEN RETURN
  279.       pp=INSTR(a$(1),"  ")
  280.       p1$=MID$(a$(1),p+1,pp-p+1):p2$=LEFT$(a$(1),p-1)
  281.       a$(1)=p1$+p2$:RETURN
  282.  
  283.       '**** PUT FILE *******
  284. 800   LSET n1$=a$(1):LSET n2$=a$(2):LSET ad1$=a$(3)
  285.       LSET ad2$=a$(4):LSET city$=a$(5):LSET state$=a$(6)
  286.       LSET ph$=a$(7):LSET t1$=a$(8)
  287.       LSET t2$=a$(9):PUT 2,rec
  288.    book=INT(rec/246):cpos=rec-(book*245)
  289.   FOR chap=1 TO 9
  290.     MID$(index$(chap,book),cpos,1)=UCASE$(LEFT$(a$(chap),1))
  291.   NEXT
  292.   RETURN
  293.  
  294.      '****** SAVE INDEX FILE BEFORE QUITING ********
  295. 900   IF savefile THEN
  296.         CLS
  297.         PRINT "SAVING INDEX FILE AND CLOSING FILES"
  298.         GOSUB 800:CLOSE #1:GOSUB 2010
  299.       END IF  
  300.       CLOSE:CLS:PRINT "HAVE A NICE DAY"      
  301.       PRINT
  302.       PRINT"type `SYSTEM' to Exit Amiga Basic
  303.       END
  304.  
  305.      '****** BACKUP FILES ******
  306. 920   IF change THEN GOSUB 800
  307. 930   CLS:PRINT "Use CLI window to Backup Data files"
  308.       PRINT "Example:
  309.       PRINT" 1> copy address.dat df1:
  310.       PRINT" 1> copy address.ind df1:
  311.       PRINT
  312.       PRINT"Press any key to continue"
  313.       LINE INPUT a$
  314.       CLS
  315.       GOTO screen.refresh
  316.  
  317.   '********** GET RECORD NUMBER **********
  318. 1000 LOCATE 13,1:INPUT"Record Number";num
  319.      IF num<1 OR num>LOF(2)/262 THEN 1000
  320.      GET 2,num:rec=num
  321.      GOSUB 710:GOSUB 700
  322.      LOCATE 13,1:PRINT SPACE$(20);
  323.      GOTO 120
  324.        
  325.   '********** INDEX FILE STORAGE ********
  326. 2010  OPEN "address.ind" FOR OUTPUT AS 3
  327.       FOR x=1 TO 9
  328.         FOR y=0 TO 4
  329.          WRITE #3,index$(x,y)
  330.       NEXT y,x
  331.       CLOSE #3:RETURN
  332.  
  333.   '******* RESTORE INDEX FILE *********
  334. 2020  FOR x=1 TO 9
  335.       FOR y=0 TO 4
  336.         index$(x,y)=STRING$(245,CHR$(255))
  337.       NEXT y,x:RETURN
  338. 2025  FOR rec=1 TO LOF(2)/262
  339.        GET 2,rec
  340.        GOSUB 710
  341.        y=INT(rec/246)
  342.        p=rec-(y*245)
  343.         FOR x=1 TO 9
  344.         MID$(index$(x,y),p,1)=UCASE$(LEFT$(a$(x),1))
  345.       NEXT x,rec
  346.       RETURN
  347.  
  348.    '********* START A NEW FILE ********
  349. 2040  GOSUB 2020:GOSUB 2010:RETURN
  350.  
  351.    '***** RESTORE ROUTINES *******
  352. 2060  LOCATE 13,1:PRINT"This is going to take a while"
  353.       GOSUB 2020:GOSUB 2025
  354.       GOSUB 2010
  355.       LOCATE 13,1:PRINT SPACE$(30);
  356.       GOTO 120
  357.  
  358. '**** ABasiC.Address to Amiga Basic.Address converter ******
  359. 3000  OPEN "address.dat" AS 3 LEN=315
  360.       FIELD 3,160 AS p1$,15 AS j1$,20 AS p2$,15 AS j2$,12 AS p3$,23 AS j3$,70 AS p4$
  361.       OPEN "df1:address.dat" AS 2 LEN=262
  362.       FIELD 2,262 AS dat$
  363.    FOR x=1 TO LOF(3)/315
  364.      LOCATE 2:PRINT x
  365.      GET 3
  366.      d$=p1$+p2$+p3$+p4$
  367.      LSET dat$=d$
  368.      PUT 2
  369.    NEXT x
  370.    STOP
  371.    KILL"address.dat"
  372.    NAME "new.address.dat" AS "address.dat"
  373.    CLOSE:END  
  374.   
  375.   ' ****** PRINT INDEX FILE ******
  376. 3500  FOR x=1 TO 9:FOR y=0 TO 4:PRINT index$(x,y):NEXT y,x
  377.       END
  378.  
  379.   '****** HARDCOPY ******
  380. 4000  WINDOW 9,"***** HARDCOPY ******",(0,10)-(600,170),0
  381. 'DRAW BOXES
  382.   CLS
  383.   LINE(4,7)-(163,51),1,b
  384.   LINE(4,63)-(147,98),1,b
  385.   LINE(180,7)-(339,58),1,b
  386.   LINE(350,7)-(554,130),1,b
  387.   LINE(179,85)-(229,99),2,b:LINE(242,85)-(284,99),2,b
  388.   LINE(403,109)-(448,122),2,b:LINE(483,109)-(527,122),2,b
  389.   LINE(71,18)-(107,18):LINE(28,73)-(113,73):LINE(188,18)-(321,18)
  390.   LINE(442,9)-(442,105):LINE(445,9)-(445,105)
  391.   LINE(498,9)-(498,105):LINE(501,9)-(501,105)
  392.   LINE(353,29)-(550,29):LINE(353,26)-(550,26)
  393.   FOR x=39 TO 103 STEP 8
  394.    LINE(353,x)-(550,x)
  395.   NEXT x
  396. 'PUT LABELS IN BOXES
  397.   LOCATE 2,10
  398.   PRINT "JOBS":LOCATE 4
  399.   FOR x=13 TO 15:PRINT TAB(2);label$(x):NEXT x
  400.   LOCATE 9,5:PRINT "NAME 1 SET";:LOCATE 11,2
  401.   PRINT label$(16):LOCATE 12,2:PRINT label$(17)
  402.   LOCATE 2,25:PRINT "RECORD SELECTION"
  403.   LOCATE 4
  404.   FOR x=18 TO 21:PRINT TAB(24);label$(x):NEXT x
  405.   LOCATE 5
  406.   FOR x=1 TO 9:PRINT TAB(45);title$(x):NEXT x
  407.   LOCATE 2,57:PRINT "PRINT";TAB(64);"SORT";
  408.   LOCATE 3,57:PRINT "FIELDS";TAB(64);"PRIOR."
  409.   LOCATE 12,24:PRINT "PRINT";TAB(32);"EXIT";
  410.   
  411.   'SET UP CURRANT VALUES
  412. 4100  mode=2
  413.        GOSUB 4110
  414.         GOSUB 4115
  415.          GOSUB 4120
  416.           GOSUB 4125
  417.            GOSUB 4145
  418.             GOTO 4150
  419. 4110  COLOR 1,mode:LOCATE job+3,2
  420.       PRINT label$(job+12):COLOR 1,0:RETURN
  421. 4115  COLOR 1,mode:LOCATE 10+name1,2
  422.       PRINT label$(name1+15):COLOR 1,0:RETURN
  423. 4120  COLOR 1,mode:LOCATE recsel+3,24
  424.       PRINT label$(recsel+17):COLOR 1,0
  425.   IF recsel=1 THEN
  426.     LOCATE 18,2:PRINT SPACE$(40)
  427.   ELSEIF recsel=4 THEN
  428.     LOCATE 15,2:PRINT SPACE$(40)
  429.   ELSEIF recsel=2 THEN
  430.     LOCATE 5
  431.     FOR z=1 TO 9
  432.       PRINT TAB(45);title$(z)
  433.     NEXT z
  434.   ELSE
  435.     cfield=0
  436.   END IF
  437.   RETURN
  438.   'SET UP PRINT FIELDS/SORT PRIOR.
  439. 4125 
  440.   FOR bit=1 TO 9
  441.     LOCATE bit+4,58
  442.     IF pfield AND bin(bit) THEN PRINT "»»»" ELSE PRINT "   "
  443.     LOCATE bit+4,66
  444.     IF MID$(sortp$,bit,1)<>"0" THEN PRINT MID$(sortp$,bit,1)
  445.    NEXT bit
  446.    RETURN
  447. 4145  LOCATE 15,52:COLOR 1,2-stat:PRINT "MARK";
  448.      COLOR 1,stat:PRINT TAB(63);"RUB";
  449.      COLOR 1,0
  450.     RETURN
  451.   
  452.     'MOUSE SELECTIONS
  453. 4150  IF MOUSE(0)>-1 THEN 4150
  454.   x=MOUSE(1):y=MOUSE(2)
  455.   IF x>4 AND x<163 AND y>23 AND y<48 THEN
  456.     mode=0:GOSUB 4110:mode=2
  457.     ON INT(y/8)-2 GOSUB 4300,4350,4400
  458.     GOTO 4150
  459.   END IF  
  460.    IF x>4 AND x<147 AND y>79 AND y<96 THEN
  461.      mode=0:GOSUB 4115:mode=2
  462.      ON INT(y/8)-9 GOSUB 4450,4475
  463.      GOTO 4150
  464.    END IF  
  465.   IF x>180 AND x<339 AND y>23 AND y<56 THEN
  466.     mode=0:GOSUB 4120:mode=2
  467.     ON INT(y/8)-2 GOSUB 4500,4550,4600,4650
  468.     GOTO 4150
  469.   END IF  
  470.   IF x>445 AND x<554 AND y>30 AND y<104 THEN
  471.     ON INT(x/55)-7 GOSUB 4700,4750
  472.     GOTO 4150
  473.   END IF  
  474.   IF x>403 AND x<448 AND y>109 AND y<122 THEN
  475.     stat=0:GOSUB 4145:GOTO 4150
  476.   END IF  
  477.   IF x>483 AND x<527 AND y>109 AND y<122 THEN
  478.     stat=2:GOSUB 4145:GOTO 4150
  479.   END IF  
  480.   IF x>179 AND x<229 AND y>85 AND y<99 THEN GOSUB 4800
  481.   IF x>242 AND x<284 AND y>85 AND y<99 THEN 
  482.     WINDOW CLOSE 9:GOTO 120
  483.   END IF   
  484.   GOTO 4150
  485.  
  486.   '****** VARIABLE SETS ******
  487. 4300  job=1:GOSUB 4110:pfield=53:GOSUB 4125:RETURN
  488. 4350  job=2:GOSUB 4110:pfield=127:GOSUB 4125:RETURN
  489. 4400  job=3:GOSUB 4110:pfield=0:GOSUB 4125:RETURN
  490.  
  491. 4450  name1=1:GOSUB 4115:RETURN
  492. 4475  name1=2:GOSUB 4115:RETURN
  493. 4499  '***** CHOOSE RECORDS ****
  494. 4500  recsel=1:GOSUB 4120
  495.       LOCATE 14,2:PRINT "TYPE `E' + <RETURN> WHEN FINISHED"
  496.       LOCATE 18,2:PRINT "RECORDS CHOSEN ";SPACE$(40);
  497.       FOR c=1 TO 10:choose(c)=0:NEXT c:c=1
  498. 4510  LOCATE 15,2:LINE INPUT"RECORD # ";a$
  499.      IF UCASE$(a$)="E" THEN 4540
  500.     IF VAL(a$)=0 THEN 4510
  501.    IF VAL(a$)>LOF(2)/262 THEN 4510
  502.   LOCATE 18,c*4+14:choose(c)=VAL(a$):PRINT choose(c);
  503.  c=c+1:IF c<11 THEN 4510
  504. 4540  LOCATE 14,2:PRINT SPACE$(40)
  505.       PRINT TAB(2);SPACE$(40):RETURN
  506.  
  507.      '*** MATCH FIELD STRING ***
  508. 4550  recsel=2:GOSUB 4120
  509.      LOCATE 15,2:PRINT "Choose Match Field With MOUSE";
  510.     LOCATE 5:FOR x=1 TO 9:PRINT TAB(45);title$(x):NEXT x
  511. 4555  IF MOUSE(0)>-1 THEN 4555
  512.      x=MOUSE(1):y=MOUSE(2)
  513.      IF x>353 THEN IF x<442 THEN IF y>32 THEN IF y<104 THEN 4570
  514.   
  515.     GOTO 4555
  516. 4570  fpos=INT(y/8)-3:COLOR 1,2:LOCATE fpos+4,45
  517.       PRINT title$(fpos)
  518.       COLOR 1,0
  519.       LOCATE 15,2:LINE INPUT"TYPE IN MATCH STRING ";search$
  520.       search$=UCASE$(search$)
  521.       LOCATE 15,2:PRINT "MATCH STRING IS "search$;SPACE$(20)
  522.       RETURN
  523.  
  524.     '*** MATCH RECORD STRING ***
  525. 4600  recsel=3:GOSUB 4120
  526.   LOCATE 15,2:LINE INPUT"TYPE IN MATCH STRING ";search$
  527.   search$=UCASE$(search$)
  528.   LOCATE 15,2:PRINT "MATCH STRING IS ";search$;SPACE$(20);
  529.   RETURN
  530.   '*** ALL RECORDS ***
  531. 4650  recsel=4:GOSUB 4120:RETURN
  532.   '*** PRINT FIELDS/SORT PRIOR. ***
  533. 4700  p=INT(y/8)-3:LOCATE p+4,58
  534.       ON (stat/2)+1 GOTO 4710,4720
  535. 4710  IF pfield AND bin(p) THEN RETURN 
  536.       pfield=pfield+bin(p)
  537.       PRINT "»»»";:RETURN
  538. 4720  IF pfield AND bin(p) THEN
  539.         PRINT "   ";
  540.         pfield=pfield-bin(p)
  541.       END IF
  542.       RETURN
  543. 4750  p=INT(y/8)-3:LOCATE p+4,65
  544.       ON (stat/2)+1 GOTO 4760,4780
  545. 4760  IF snum=4 THEN RETURN
  546.       IF MID$(sortp$,p,1)<>"0" THEN RETURN
  547.       snum=snum+1
  548.       MID$(sortp$,p,1)=RIGHT$(STR$(snum),1)
  549.       PRINT STR$(snum);
  550.       RETURN
  551. 4780  m$=MID$(sortp$,p,1):IF m$="0" THEN RETURN
  552.       snum=VAL(m$)-1
  553.       FOR x=1 TO 9
  554.         IF VAL(MID$(sortp$,x,1))>snum THEN
  555.           MID$(sortp$,x,1)="0"
  556.           LOCATE x+4,65:PRINT "  ";
  557.         END IF
  558.       NEXT x
  559.       RETURN
  560.     '** PRINT **
  561. 4800  LOCATE 17,2:INPUT"HOW MANY COPIES";cop
  562.       sp=INSTR(sortp$,"1"):GOSUB 5000
  563.   OPEN "O",#7,"Par:"
  564.   FOR y=1 TO cop:FOR x=1 TO recn
  565.   GET 2,orig(x):GOSUB 710
  566.   IF name1=1 THEN GOSUB 720
  567.   IF job=1 THEN
  568.     PRINT #7,a$(1):PRINT #7,a$(3)
  569.     p=INSTR(a$(5),"  "):PRINT #7,LEFT$(a$(5),p+1);
  570.     PRINT #7,a$(6)
  571.     PRINT #7,"":PRINT #7,"":PRINT #7,""
  572.     END IF  
  573.   IF job=2 THEN
  574.     PRINT #7,a$(1):PRINT #7,a$(2)
  575.     PRINT #7,a$(3):PRINT #7,a$(4)
  576.     p=INSTR(a$(5),"  "):PRINT #7,LEFT$(a$(5),p+1);
  577.     PRINT #7,LEFT$(a$(6),9);:PRINT #7,a$(7):PRINT #7,""
  578.     END IF  
  579.   IF job=3 THEN
  580.     l=0
  581.     PRINT #7,""
  582.     FOR bit=1 TO 9
  583.       IF pfield AND bin(bit) THEN
  584.         PRINT #7,a$(bit)" ";
  585.         l=l+LEN(a$(bit))
  586.       END IF   
  587.       IF bit=2 THEN
  588.         PRINT #7,"("orig(x)")";
  589.       END IF  
  590.       IF bit=7 OR l>69 THEN PRINT #7,"":PRINT #7,"          ";:l=0
  591.     NEXT bit
  592.   END IF  
  593.  NEXT x,y
  594.   CLOSE #7
  595.   LOCATE 17,2:PRINT SPACE$(20);
  596.   ERASE sort$:ERASE orig
  597.   RETURN
  598.   
  599.   '** SORT ROUTINE **
  600. 5000  DIM sort$(LOF(2)/262),orig(LOF(2)/262)
  601.   recn=0
  602.  FOR y=1 TO snum
  603.    a(y)=INSTR(sortp$,RIGHT$(STR$(y),1))
  604.  NEXT y
  605.   ON recsel GOSUB 5100,5200,5300,5400
  606. 5015  IF sp=0 THEN RETURN
  607. 5020  change=0
  608.      FOR x=1 TO recn-1
  609.        IF sort$(x)<=sort$(x+1) THEN 5050
  610.        change=1:SWAP orig(x),orig(x+1)
  611.        SWAP sort$(x),sort$(x+1)
  612. 5050  NEXT x
  613. 5060  IF change THEN 5020
  614.        RETURN
  615.   
  616. 5100  FOR x=1 TO 10
  617.        IF choose(x)=0 THEN RETURN
  618.        recn=recn+1
  619.        GET 2,choose(x):GOSUB 710:orig(x)=choose(x)
  620.       IF sp THEN
  621.         sort$(x)=""
  622.         FOR y=1 TO snum
  623.           sort$(x)=sort$(x)+UCASE$(a$(a(y)))
  624.         NEXT y
  625.       END IF  
  626.       NEXT x:RETURN
  627.  
  628. 5200  book=-1:x=1 
  629. 5205  IF book=4 THEN RETURN
  630.       book=book+1
  631. 5215  IF x>LOF(2)/262 THEN RETURN
  632. 5220  cpos=INSTR(x-(book*245),index$(fpos,book),LEFT$(search$,1))
  633.       IF cpos=0 THEN x=((book+1)*246):GOTO 5205
  634.       x=cpos+(book*245)
  635.       GET 2,x
  636.       GOSUB 455
  637.       IF search$=UCASE$(LEFT$(fstr$,LEN(search$))) THEN GOSUB 710 ELSE 5280
  638.       recn=recn+1:orig(recn)=x
  639.       IF sp THEN
  640.         sort$(recn)=""
  641.         FOR y=1 TO snum
  642.           sort$(recn)=sort$(recn)+UCASE$(a$(a(y)))
  643.         NEXT y
  644.       END IF  
  645. 5280  x=x+1
  646.       GOTO 5220
  647.  
  648. 5300  GET 2,1    
  649.       FOR x=1 TO LOF(2)/262-1:GOSUB 710
  650.         FOR look=1 TO 9
  651.           p=INSTR(UCASE$(a$(look)),search$)
  652.           IF p=0 THEN 5380
  653.           recn=recn+1:orig(recn)=x
  654.           IF sp THEN
  655.             sort$(recn)=""
  656.             FOR y=1 TO snum
  657.               sort$(recn)=sort$(recn)+UCASE$(a$(a(y)))
  658.             NEXT y
  659.           END IF  
  660.           look=9
  661. 5380    NEXT look
  662.         GET 2
  663.       NEXT x
  664.       RETURN
  665.  
  666. 5400  GET 2,1
  667.       FOR x=1 TO LOF(2)/262
  668.         recn=LOF(2)/262
  669.         GOSUB 710:orig(x)=x
  670.         IF sp THEN
  671.           sort$(x)=""
  672.           FOR y=1 TO snum
  673.             sort$(x)=sort$(x)+UCASE$(a$(a(y)))
  674.           NEXT y
  675.         END IF  
  676.         GET 2
  677.       NEXT x:RETURN
  678.  
  679. 6000 GOSUB 2040:RESUME
  680. '********* gettext **************
  681. 'This is a subprogram that takes 
  682. 'characters from the keyboard and 
  683. 'puts them on the screen.
  684. 'Includes keyboard features of the
  685. 'Basic Editor
  686. SUB gettext(lines,topx,topy,wide,a$(),cur,bc) STATIC
  687. l=1:p=1:c=cur
  688. FOR x=1 TO lines
  689.   IF a$(x)="" THEN a$(x)=SPACE$(wide)
  690. NEXT x
  691. GOSUB putcursor:  
  692. getkey:
  693.   IF MOUSE(0)<0 THEN
  694.     IF MOUSE(1)>(topy-1)*8 THEN
  695.       IF MOUSE(1)<(topy+wide)*8 THEN
  696.         IF MOUSE(2)>(topx-1)*8 THEN
  697.           IF MOUSE(2)<(topx+lines-1)*8 THEN
  698.             c=bc:GOSUB putcursor:c=cur
  699.             p=INT(MOUSE(1)/8)-topy+2
  700.             l=INT(MOUSE(2)/8)-topx+2
  701.             GOSUB putcursor
  702.           END IF
  703.         END IF
  704.       END IF
  705.     END IF
  706.   END IF         
  707.   a$=INKEY$
  708.   IF a$="" THEN getkey
  709.   IF a$=CHR$(27) THEN 
  710.     c=bc:GOSUB putcursor
  711.     EXIT SUB
  712.   END IF    
  713.   IF a$=CHR$(13) THEN 
  714.     IF l=lines THEN BEEP:GOTO getkey
  715.     c=bc:GOSUB putcursor:c=cur
  716.     p=1:l=l+1:GOTO 100
  717.   END IF   
  718.   IF a$=CHR$(8) THEN 
  719.     IF p>1 THEN 
  720.       c=bc:GOSUB putcursor:c=cur 
  721.       p=p-1
  722.       a$(l)=LEFT$(a$(l),p-1)+MID$(a$(l),p+1)+" "
  723.       LOCATE topx+l-1,topy
  724.       PRINT a$(l)
  725.       GOTO 100
  726.     ELSE 
  727.       GOTO getkey
  728.     END IF
  729.   END IF   
  730.   ON INSTR(CHR$(28)+CHR$(29)+CHR$(30)+CHR$(31),a$)GOTO up,down,right,left 
  731.   IF p>wide THEN BEEP:GOTO getkey  
  732.   IF RIGHT$(a$(l),wide+1-p)=SPACE$(wide+1-p) THEN
  733.     MID$(a$(l),p,1)=a$
  734.     LOCATE topx+l-1,topy+p-1
  735.     PRINT a$;
  736.   ELSE
  737.     a$(l)=LEFT$(a$(l),p-1)+a$+MID$(a$(l),p,wide-p)
  738.     LOCATE topx+l-1,topy
  739.     PRINT a$(l)
  740.   END IF
  741.   p=p+1   
  742. 100 :
  743.   GOSUB putcursor  
  744.   GOTO getkey
  745. up:
  746.   IF l=1 THEN BEEP:GOTO getkey
  747.   c=bc:GOSUB putcursor:c=cur
  748.   l=l-1:GOTO 100
  749. down:
  750.   IF l=lines THEN BEEP:GOTO getkey
  751.   c=bc:GOSUB putcursor:c=cur
  752.   l=l+1:GOTO 100  
  753. right:
  754.   IF p>wide THEN BEEP:GOTO getkey
  755.   c=bc:GOSUB putcursor:c=cur
  756.   p=p+1:GOTO 100
  757. left:
  758.   IF p=1 THEN BEEP:GOTO getkey
  759.   c=bc:GOSUB putcursor:c=cur
  760.   p=p-1:GOTO 100
  761. putcursor:
  762.   LINE((topy+p-2)*8,(topx+l-2)*8)-((topy+p-2)*8,(topx+l-2)*8+6),c
  763.   RETURN
  764. END SUB
  765. '****** requester subprogram *********
  766. SUB requester(flag,topx,topy,message$,win,choice0$,choice1$)STATIC
  767.   SHARED answer
  768.   IF flag%=1 THEN alreadyopen
  769.   WINDOW 3,"requester",(topx%,topy%)-(topx%+180,topy%+32),2
  770. alreadyopen:
  771.   WINDOW OUTPUT 3
  772.   LOCATE 1,1:PRINT message$
  773.   LINE(4,13)-(76,24),2,bf
  774.   LINE(92,13)-(164,24),2,bf  
  775.   LOCATE 3,6-INT(LEN(choice0$)/2):PRINT choice0$;
  776.   LOCATE 3,16-INT(LEN(choice1$)/2):PRINT choice1$;
  777. choose3:  
  778.   IF MOUSE(0)>-1 THEN choose3
  779.   IF MOUSE(1)<4 THEN choose3
  780.   IF MOUSE(1)>164 THEN choose3
  781.   IF MOUSE(2)<4 THEN choose3
  782.   IF MOUSE(2)>24 THEN choose3
  783.     answer=INT((MOUSE(1)-8)/72)
  784.   WINDOW OUTPUT win  
  785. END SUB                  
  786.